home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / mltsktp.zip / PRO_CON.PAS < prev    next >
Pascal/Delphi Source File  |  1988-09-20  |  15KB  |  410 lines
  1. {$R-,S-,I-,D-,T-,F-,V+,B-,N-,L+ }
  2. {$M 16384,0,655360 }
  3. PROGRAM ProducerConsumer;
  4.  
  5. { Solution of the Producer-Consumer-Problem; Example: Keyboard-I/O
  6.  
  7.   What is does:
  8.     This program reads characters from the keyboard and displays them in
  9.     a small window on the screen. It also displays status-information about
  10.     the current state of the ring-buffer, the tasks and the semaphores in
  11.     the system.
  12.     ESC : Terminate
  13.     ^S  : The output of characters is suspended until ^Q is received.
  14.           Incoming characters are put into the ring-buffer, however, until
  15.           the buffer overflows.
  16.     ^Q  : Resume character output; the currently stored characters are
  17.           instantaneously displayed.
  18.  
  19.  
  20.   Stand: 6/88
  21.   Autor: Christian Philipps
  22.          Hülsdonker Str. 139a
  23.          4130 Moers 1
  24. }
  25.  
  26. USES Crt, TP4Multi;
  27.  
  28. CONST RBuffSize = 36;                            {Size of Ring-Buffer}
  29.       CritLin   = 15;
  30.       CritCol   = 51;
  31.       FullLin   = 15;
  32.       FullCol   = 34;
  33.       EmptyLin  = 15;
  34.       EmptyCol  = 42;
  35.       PEndLin   = 15;
  36.       PEndCol   = 12;
  37.       OutLin    = 15;
  38.       OutCol    = 24;
  39.  
  40. VAR   RBuff     : RECORD
  41.                     Buff     : ARRAY[0..RBuffSize] OF CHAR;
  42.                                                  {Ring-Buffer; Last element
  43.                                                   not used, thereby easier to
  44.                                                   handle}
  45.                     Critical : Pointer;          {Semaphore for Access-Synchro-
  46.                                                   nisation}
  47.                     Full     : Pointer;          {Semaphore, used to count
  48.                                                   used bffer-sots}
  49.                     Empty    : Pointer;          {Semaphore, used to cont
  50.                                                   empty buffer-slots}
  51.                     Head     : Byte;             {Head- and Tailpointer}
  52.                     Tail     : Byte;
  53.                   END;
  54.       OutputSem : Pointer;                       {Semaphore, used to control
  55.                                                   character output}
  56.       ProgramEnd: Pointer;                       {Semphore, used to signal
  57.                                                   program end}
  58.       ConsumerNo,                                {Task-IDs}
  59.       ProducerNo: TaskNoType;
  60.  
  61. {-----------------------------------------------------------------------------}
  62.  
  63. FUNCTION NextSlot(S:Byte):Byte;
  64.  
  65. { Calculate the next buffer position }
  66.  
  67. BEGIN {NextSlot}
  68.   NextSlot := Succ(S) MOD RBuffSize;
  69. END;  {NextSlot}
  70.  
  71. {-----------------------------------------------------------------------------}
  72.  
  73. PROCEDURE WriteCharXY(X,Y:Byte; C:Char);
  74.  
  75. { Output a character at X,Y. Thereby assure that the sequence GotoXY/Write is
  76.   always treated as an atomic action. This is done by blocking the CPU }
  77.  
  78. BEGIN {WriteCharXY}
  79.   BindCPU;
  80.   GotoXY(X,Y);
  81.   Write(C);
  82.   ReleaseCPU;
  83. END;  {WriteCharXY}
  84.  
  85. {-----------------------------------------------------------------------------}
  86.  
  87. PROCEDURE WriteByteXY(X,Y,B:Byte);
  88.  
  89. { Output a two-digit byte-value at X,Y. See also: WriteCharXY for further
  90.   explanation }
  91.  
  92. BEGIN {WriteByteXY}
  93.   BindCPU;
  94.   GotoXY(X,Y);
  95.   Write(B:2);
  96.   ReleaseCPU;
  97. END;  {WriteByteXY}
  98.  
  99. {-----------------------------------------------------------------------------}
  100.  
  101. PROCEDURE Status;
  102.  
  103. { Display Task-Status }
  104.  
  105. BEGIN {Status}
  106.   BindCPU;
  107.   GotoXY(65,9);
  108.   Write(StateText[GetTaskState(ConsumerNo)]:10);
  109.   GotoXY(65,22);
  110.   Write(StateText[GetTaskState(ProducerNo)]:10);
  111.   ReleaseCPU;
  112. END;  {Status}
  113.  
  114. {-----------------------------------------------------------------------------}
  115.  
  116. PROCEDURE SW(S:Pointer; c,l:byte);
  117.  
  118. { Execute and visualize SemWait() }
  119.  
  120. BEGIN {SW}
  121.   WriteByteXY(C,L,SemGetSignals(S));
  122.   SemWait(S);
  123.   WriteByteXY(C,L,SemGetSignals(S));
  124.   Status;
  125. END;  {SW}
  126.  
  127. {-----------------------------------------------------------------------------}
  128.  
  129. PROCEDURE SS(S:Pointer; c,l:byte);
  130.  
  131. { Execute and visualize SemSignal() }
  132.  
  133. BEGIN {SS}
  134.   SemSignal(S);
  135.   WriteByteXY(C,L,SemGetSignals(S));
  136.   Status;
  137. END;  {SS}
  138.  
  139. {-----------------------------------------------------------------------------}
  140.  
  141. FUNCTION RBuffPut(C:Char):BOOLEAN;
  142.  
  143. { Insert a character into the ring-buffer. The function returns TRUE if
  144.   successful, otherwise FALSE. If FALSE is returned a buffer-overflow has
  145.   been detected.
  146.   The behavior of the output task is influenced by the input-control task
  147.   (^Q and ^S).
  148.   Therefore the input-control task must never become blocked for more than
  149.   a moment during the insertion of a character into the ring-buffer. If
  150.   we would simply wait for a slot to become empty, this would block the input
  151.   task which in turn prevented it from detecting a ^Q if output is currently
  152.   suspended. Thus the output task will be forever waiting for a ^S to be
  153.   signalled by the input-task whilst the input-task would be waiting for
  154.   the output-task to empty a slot in the ring-buffer.
  155.   Please note the position of the SemWait-Calls referring to the semaphore
  156.   "Critical"!! It is very important to keep the ring-buffer bound to our-
  157.   selves until the buffer-slot is actually filled! If we first had a look
  158.   at the signal-count of Empty to find out, whether an empty slot exists,
  159.   without having locked the buffer before, anoter task could theoretically
  160.   have taken away the last slot available between our SemGetSignals and our
  161.   SemWait. - Again the deadlock described above were the consequence. }
  162.  
  163. BEGIN {RBuffPut}
  164.   WITH RBuff DO
  165.   BEGIN
  166.     SW(Critical,CritCol,CritLin);                {gain exclusive access}
  167.     IF SemGetSignals(Empty) = 0                  {Buffer full}
  168.        THEN RBuffPut := False                    {prevent deadlock}
  169.        ELSE BEGIN
  170.               RBuffPut := True;
  171.               SW(Empty,EmptyCol,EmptyLin);       {claim a slot}
  172.               Buff[Tail] := c;                   {insert character}
  173.               WriteCharXY(21+Tail,19,' ');
  174.               IF C = #13
  175.                  THEN WriteCharXY(21+Tail,21,#188)
  176.                  ELSE WriteCharXY(21+Tail,21,c);
  177.               Tail := NextSlot(Tail);            {advance headpointer}
  178.               WriteCharXY(21+Tail,19,#25);
  179.               SS(Full,FullCol,FullLin);          {count new character}
  180.             END;
  181.     SS(Critical,CritCol,CritLin);                {release buffer}
  182.   END;
  183. END;  {RBuffPut}
  184.  
  185. {-----------------------------------------------------------------------------}
  186.  
  187. FUNCTION RBuffGet:Char;
  188.  
  189. { Take the first Character out of the buffer and pass it to the application.
  190.   If the buffer is currently empty, wait. }
  191.  
  192. BEGIN {RBuffGet}
  193.   WITH RBuff DO
  194.   BEGIN
  195.     SW(Full,FullCol,FullLin);                    {ask for character}
  196.     SW(Critical,CritCol,CritLin);                {gain exclusive access}
  197.     RBuffGet := Buff[Head];                      {take character}
  198.     WriteCharXY(21+Head,23,' ');
  199.     Head := NextSlot(Head);                      {advance headpointer}
  200.     WriteCharXY(21+Head,23,#24);
  201.     SS(Critical,CritCol,CritLin);                {release buffer}
  202.     SS(Empty,EmptyCol,EmptyLin);                 {count emptied slot}
  203.   END;
  204. END;  {RBuffGet}
  205.  
  206. {-----------------------------------------------------------------------------}
  207.  
  208. PROCEDURE Producer;
  209.  
  210. { Input-Control Task: Read characters from the keyboard and store them
  211.   in the ring-buffer.
  212.   Whenever a ^S is received, the output of characters to the screen is
  213.   suspended until a ^Q is received }
  214.  
  215. VAR   C       : Char;
  216.       Display : Boolean;
  217.       Col     : Byte;
  218.  
  219. BEGIN {Producer}
  220.   Display := True;                               {output active}
  221.   Col := 1;
  222.   REPEAT                                         {endless loop}
  223.     WHILE Keypressed DO
  224.     BEGIN
  225.       C := ReadKey;
  226.       CASE C OF
  227.         ^S: IF Display                           {if not already done}
  228.                THEN BEGIN
  229.                       SW(OutputSem,OutCol,OutLin); {inhibit output}
  230.                       Display := False;          {store state}
  231.                     END;
  232.         ^Q: IF NOT Display                       {if output suspended}
  233.                THEN BEGIN
  234.                       SS(OutputSem,OutCol,OutLin); {reenable output}
  235.                       Display := True;           {store state}
  236.                     END;
  237.        ELSE                                      {no special character}
  238.          BEGIN
  239.            IF NOT RBuffPut(C)
  240.               THEN BEGIN                         {Overflow}
  241.                      BindCPU;                    {atomic action}
  242.                      GotoXY(34,18);
  243.                      TextBackground(White);
  244.                      TextColor(Black);
  245.                      Write(' Overflow ');
  246.                      TextColor(White);
  247.                      TextBackground(Black);
  248.                      ReleaseCPU;                 {End atomic action}
  249.                    END;
  250.          END;
  251.       END; {Case}
  252.     END;
  253.     Sched;                                       {All characters used up;
  254.                                                   give up time-slice}
  255.   UNTIL False;
  256. END;  {Producer}
  257.  
  258.  
  259. {-----------------------------------------------------------------------------}
  260.  
  261. PROCEDURE Consumer;
  262.  
  263. { This task takes characters out of the ring-buffer and displays them to the
  264.   screen.
  265.   Whenever a ^S is received by the input-control-task, the "OutputSem" is
  266.   marked busy which leads to a block of the Output-Task.
  267.   "OutputSem" is released when a ^Q is received.
  268.   If an ESC is encountered, this task sets the semaphore "ProgramEnd" to
  269.   signal program termination.
  270.   The Consumer-Task is executed with highest priority, because it spends
  271.   most of its time waiting for input. If, however, characters are avail-
  272.   able, these are processed as quickly as possible. }
  273.  
  274. CONST  MaxCols = 50;
  275.  
  276. VAR  C   : Char;
  277.      Col : Byte;
  278.  
  279. BEGIN {Consumer}
  280.   Col := 1;
  281.   REPEAT                                         {endless loop}
  282.     C := RBuffGet;                               {get character}
  283.     GotoXY(34,18);                               {clear overflow-message}
  284.     Write('          ');
  285.     IF C = #27
  286.        THEN SS(ProgramEnd,PendCol,PendLin)       {end of program}
  287.        ELSE BEGIN
  288.               SW(OutPutSem,OutCol,OutLin);       {wait for output permission}
  289.               IF (Col >= MaxCols) OR (C=#13)     {display overflow / Return}
  290.                  THEN BEGIN
  291.                         BindCPU;                 {critical section}
  292.                         GotoXY(7,8);
  293.                         FOR Col := 1 TO MaxCols DO
  294.                           Write(' ');
  295.                         ReleaseCPU;              {end of critical section}
  296.                         Col := 1;
  297.                       END;
  298.               IF C <> #13                        {output character}
  299.                  THEN BEGIN
  300.                         WriteCharXY(6+Col,8,C);
  301.                         Inc(Col);
  302.                       END;
  303.               SS(OutPutSem,OutCol,OutLin);       {increment signal-count}
  304.             END;
  305.   UNTIL False;
  306. END;  {Consumer}
  307.  
  308. {-----------------------------------------------------------------------------}
  309.  
  310. PROCEDURE DrawScreen;
  311.  
  312. BEGIN {DrawScreen}
  313.   ClrScr;
  314.   BindCPU;
  315.   GotoXY(15,1);
  316.   Write('P R O C E S S  -  S Y N C H R O N I S A T I O N');
  317.   GotoXY(18,3);
  318.   Write('A Solution Of The Producer-Consumer Problem');
  319.   GotoXY(24,4);
  320.   Write('Autor: Christian Philipps 6/88');
  321.   GotoXY(5,7);
  322.   Write('┌───────────────────────────────────────────────────┐');
  323.   GotoXY(5,8);
  324.   Write('│                                                   │ Consumer-Task');
  325.   GotoXY(5,9);
  326.   Write('└───────────────────────────────────────────────────┘');
  327.   GotoXY(6,12);
  328.   Write('┌────────────┬───────────┬──────┬───────┬──────────┐');
  329.   GotoXY(6,13);
  330.   Write('│ ProgramEnd │ OutputSem │ Full │ Empty │ Critical │ Semaphores for');
  331.   GotoXY(6,14);
  332.   Write('├────────────┼───────────┼──────┼───────┼──────────┤ Prozess- and Access-');
  333.   GotoXY(6,15);
  334.   Write('│            │           │      │       │          │ synchronisation');
  335.   GotoXY(6,16);
  336.   Write('└────────────┴───────────┴──────┴───────┴──────────┘');
  337.   GotoXY(5,19);
  338.   Write('Head-Pointer');
  339.   GotoXY(20,20);
  340.   Write('┌────────────────────────────────────┐');
  341.   GotoXY(5,21);
  342.   Write('Ringpuffer ->  │                                    │ Producer─Task');
  343.   GotoXY(20,22);
  344.   Write('└────────────────────────────────────┘');
  345.   GotoXY(5,23);
  346.   Write('Tail-Pointer');
  347.   TextColor(Black);
  348.   TextBackground(White);
  349.   GotoXY(1,25);
  350.   Write('  Ctrl-S  Suspend Output  /  Ctrl-Q  Resume Output  /  ESC  End Program        ');
  351.   TextColor(White);
  352.   TextBackground(Black);
  353.   ReleaseCPU;
  354.   WriteCharXY(25,11,#30);
  355.   WriteCharXY(35,11,#30);
  356.   WriteCharXY(42,11,#30);
  357.   WriteCharXY(51,11,#30);
  358.   WriteCharXY(25,17,#30);
  359.   WriteCharXY(35,17,#30);
  360.   WriteCharXY(42,17,#30);
  361.   WriteCharXY(51,17,#30);
  362.   WriteCharXY(21,19,#25);
  363.   WriteCharXY(21,23,#24);
  364. END;  {DrawScreen}
  365.  
  366. {-----------------------------------------------------------------------------}
  367.  
  368. FUNCTION InitConPro:BOOLEAN;
  369.  
  370. BEGIN {InitConPro}
  371.   InitConPro := False;
  372.   WITH RBuff DO
  373.   BEGIN
  374.     FillChar(Buff,RBuffSize,' ');                {Clear buffer}
  375.     Head := 0;
  376.     Tail := 0;
  377.     IF CreateSem(Critical) <> Sem_OK             {Create semaphores}
  378.        THEN Exit;
  379.     IF CreateSem(Full) <> Sem_OK
  380.        THEN Exit;
  381.     IF CreateSem(Empty) <> Sem_OK
  382.        THEN Exit;
  383.     SemSet(Empty,RBuffSize);                     {All slots are empty...}
  384.     SemClear(Full);                              {no one is full}
  385.   END;
  386.   IF CreateSem(ProgramEnd) <> Sem_Ok             {Create program-end flag}
  387.      THEN Exit;
  388.   SemClear(ProgramEnd);                          {clear signal-count}
  389.   IF CreateSem(OutputSem) <> Sem_Ok              {Create semaphore}
  390.      THEN Exit;
  391.  
  392.   ConsumerNo := CreateTask(@Consumer,Pri_Kernel,500); {Create tasks}
  393.   ProducerNo := CreateTask(@Producer,Pri_User,500);
  394.   IF (ConsumerNo < 0) OR                         {Error?}
  395.      (ProducerNo < 0)
  396.      THEN Exit;
  397.   DrawScreen;
  398.   InitConPro := True;
  399. END;  {InitConPro}
  400.  
  401. {-----------------------------------------------------------------------------}
  402.  
  403. BEGIN {Main}
  404.   IF NOT InitConPro
  405.      THEN BEGIN
  406.             Writeln('Error during Initialisation!');
  407.             Halt;
  408.           END;
  409.   SW(ProgramEnd,PendCol,PendLin);
  410. END.  {Main}